Visual Basic 4 Database How-To/Visual Basic 4 Database - How-to (The Waite Group)(1995).iso/api.fr_/api.fr

Text File | 1995-07-19 | 10KB | 316 lines

VERSION 4.00
Begin VB.Form frmODBC
   BackColor       =   &H00C0C0C0&
   Caption         =   "ODBC Database"
   ClientHeight    =   5820
   ClientLeft      =   1095
   ClientTop       =   1470
   ClientWidth     =   7365
   BeginProperty Font
      name            =   "MS Sans Serif"
      charset         =   0
      weight          =   700
      size            =   8.25
      underline       =   0   'False
      italic          =   0   'False
      strikethrough   =   0   'False
   EndProperty
   Height          =   6315
   Left            =   990
   LinkTopic       =   "Form1"
   ScaleHeight     =   5820
   ScaleWidth      =   7365
   Top             =   1080
   Width           =   7575
   Begin VB.ListBox lstODBCDrivers
      BackColor       =   &H00C0C0C0&
      Height          =   1005
      Left            =   240
      Sorted          =   -1  'True
      TabIndex        =   3
      TabStop         =   0   'False
      Top             =   2160
      Width           =   4935
   End
   Begin VB.TextBox txtODBCStatus
      BackColor       =   &H00C0C0C0&
      Height          =   315
      Left            =   240
      TabIndex        =   4
      TabStop         =   0   'False
      Top             =   4680
      Width           =   6015
   End
   Begin VB.ListBox lstODBCDbs
      Height          =   1005
      Left            =   240
      TabIndex        =   1
      Top             =   600
      Width           =   4935
   End
   Begin VB.CommandButton cmdGetStatus
      Caption         =   "&Get ODBC Status"
      Height          =   375
      Left            =   240
      TabIndex        =   5
      Top             =   5280
      Width           =   1695
   End
   Begin VB.CommandButton cmdQuit
      Caption         =   "&Quit"
      Default         =   -1  'True
      Height          =   375
      Left            =   5040
      TabIndex        =   6
      Top             =   5280
      Width           =   1215
   End
   Begin VB.Label lblDrivers
      BackColor       =   &H00C0C0C0&
      Caption         =   "Installed ODBC Drivers:"
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   1800
      Width           =   3375
   End
   Begin VB.Label lblDatabases
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Registered ODBC Databases:"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   3375
   End
End
Attribute VB_Name = "frmODBC"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit

'Dynamic arrays to hold data
Dim dbName() As String
Dim dbDesc() As String
Dim DriverDesc() As String
Dim DriverAttr() As String

Private Sub cmdGetStatus_Click()
    Dim result As Integer

    'open the ODBC connection
    result = ODBCAllocateEnv(ghEnv)
    If result = SQL_SUCCESS Then
        GetODBCdbs
        GetODBCdvrs

        cmdGetStatus.Enabled = False
        txtODBCStatus.text = "Click one of the registered databases to obtain info."
    Else
        txtODBCStatus.text = "ODBC Information could not be retrieved."
        Exit Sub
    End If

End Sub

Private Sub cmdQuit_Click()
    End
End Sub

Private Sub Form_Load()
    txtODBCStatus.text = "Select Get ODBC Status to begin."
End Sub

Private Sub Form_Resize()
    If Me.WindowState = NORMAL Then
        If frmODBC.ScaleHeight < (9 * cmdQuit.Height) Then
            frmODBC.Height = (11 * cmdQuit.Height)
        End If
        If frmODBC.ScaleWidth < (2 * (cmdQuit.Width + cmdGetStatus.Width)) Then
            frmODBC.Width = (2 * (cmdQuit.Width + cmdGetStatus.Width))
        End If

        'Center the form
        frmODBC.TOP = (Screen.Height - frmODBC.Height) / 2
        frmODBC.Left = (Screen.Width - frmODBC.Width) / 2
    End If
    If Not (Me.WindowState = MINIMIZED) Then
        RedrawForm
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'Clean up the ODBC connections and allocations
    Dim result As Integer

    result = ODBCDisconnectDS(ghEnv, ghDbc, ghStmt)
    result = ODBCFreeEnv(ghEnv)
End Sub

Private Sub GetODBCdbs()
    Dim cbDSNMax As Integer
    Dim szDSN As String * 33
    #If Win32 Then
        Dim pcbDSN As Long
        Dim pcbDescription As Long
    #Else
        Dim pcbDSN As Integer
        Dim pcbDescription As Integer
    #End If
    Dim szDescription As String * 512
    Dim cbDescriptionMax As Integer
    Dim result As Integer
    Dim i As Integer
    Dim nameLen As Integer
    Dim ErrResult

    cbDSNMax = SQL_MAX_DSN_LENGTH + 1
    cbDescriptionMax = 512
    result = SQL_SUCCESS
    i = 0

    Screen.MousePointer = HOURGLASS
    Do While result <> SQL_NO_DATA_FOUND
        'Get next data source (on the first call to
        'SQLDataSources, SQL_FETCH_NEXT gets the first
        'data source
        result = SQLDataSources(ghEnv, SQL_FETCH_NEXT, szDSN, cbDSNMax, pcbDSN, szDescription, cbDescriptionMax, pcbDescription)
        If result = SQL_ERROR Then
            ErrResult = ODBCError("Env", ghEnv, 0, 0, result, "Error getting list of data sources.")
            Screen.MousePointer = DEFAULT
            Exit Sub
        End If

        ReDim Preserve dbName(i)
        dbName(i) = Left(szDSN, pcbDSN)
        ReDim Preserve dbDesc(i)
        dbDesc(i) = Left(szDescription, pcbDescription)

        lstODBCdbs.AddItem dbName(i) & "  (" & dbDesc(i) & ")"

        i = i + 1
    Loop
    Screen.MousePointer = DEFAULT

End Sub

Private Sub GetODBCdvrs()
    Dim szDriverDesc As String * 512
    Dim cbDriverDescMax As Integer
    #If Win32 Then
        Dim pcbDriverDesc As Long
    #Else
        Dim pcbDriverDesc As Integer
    #End If
    Dim szDriverAttributes As String * 2048
    Dim cbDrvrAttrMax As Integer
    #If Win32 Then
        Dim pcbDrvrAttr As Long
    #Else
        Dim pcbDrvrAttr As Integer
    #End If
    Dim i As Integer
    Dim result As Integer
    Dim ErrResult As Integer

    cbDriverDescMax = 512
    cbDrvrAttrMax = 2048
    result = SQL_SUCCESS
    i = 0

    Do While result <> SQL_NO_DATA_FOUND
        result = SQLDrivers(ghEnv, SQL_FETCH_NEXT, szDriverDesc, cbDriverDescMax, pcbDriverDesc, szDriverAttributes, cbDrvrAttrMax, pcbDrvrAttr)
        If result = SQL_ERROR Then
            ErrResult = ODBCError("Env", ghEnv, 0, 0, result, "Error getting list of registered drivers.")
            Exit Sub
        End If

        ReDim Preserve DriverDesc(i)
        DriverDesc(i) = Left(szDriverDesc, pcbDriverDesc)
        ReDim Preserve DriverAttr(i)
        DriverAttr(i) = Left(szDriverAttributes, pcbDrvrAttr)

        lstODBCDrivers.AddItem DriverDesc(i) & "  (" & DriverAttr(i) & ")"

        i = i + 1
    Loop

End Sub

Private Sub lstODBCDbs_Click()
    Dim DataSource As String
    Dim UserID As String
    Dim Password As String
    Dim result As Integer
    Dim ErrResult As Integer
    ReDim FuncList(100) As Integer
    Dim i As Integer, j As Integer

    Screen.MousePointer = HOURGLASS
    DataSource = dbName(lstODBCdbs.ListIndex)

    result = ODBCConnectDS(ghEnv, ghDbc, ghStmt, DataSource, UserID, Password)
    If result <> SQL_SUCCESS Then
        Screen.MousePointer = DEFAULT
        Exit Sub
    End If

    'Now get the list of functions
    result = SQLGetFunctions(ghDbc, SQL_API_ALL_FUNCTIONS, FuncList(0))
    If result <> SQL_SUCCESS Then
        ErrResult = ODBCError("Dbc", ghEnv, ghDbc, 0, result, "Error getting list of ODBC functions")
        Screen.MousePointer = DEFAULT
        Exit Sub
    End If

    Load frmAttributes

    j = 0
    For i = 0 To 99
        If FuncList(i) <> 0 Then
            frmAttributes.lstFunctions.AddItem ODBCFuncs(0, i)
            j = j + 1
        End If
    Next

    frmAttributes.txtFuncCount.text = j
    frmAttributes.Caption = "Data Source: " & DataSource

    frmAttributes.Show MODAL

    'free the data source connection
    result = ODBCDisconnectDS(ghEnv, ghDbc, SQL_NULL_HSTMT)

    Screen.MousePointer = DEFAULT

End Sub

Private Sub RedrawForm()
    Dim LBHeight As Integer

    cmdQuit.TOP = frmODBC.ScaleHeight - (1.5 * cmdQuit.Height)
    cmdQuit.Left = frmODBC.ScaleWidth - (1.25 * cmdQuit.Width)
    cmdGetStatus.TOP = cmdQuit.TOP
    cmdGetStatus.Left = 0.25 * cmdQuit.Width

    txtODBCStatus.Left = cmdGetStatus.Left
    txtODBCStatus.Width = frmODBC.ScaleWidth - (0.5 * cmdQuit.Width)
    txtODBCStatus.TOP = cmdQuit.TOP - (1.5 * cmdQuit.Height)

    'Area for each of two listbox:
    LBHeight = (txtODBCStatus.TOP - lblDatabases.TOP) / 2.05

    lstODBCdbs.TOP = lblDatabases.TOP + (1.25 * lblDatabases.Height)
    lstODBCdbs.Left = cmdGetStatus.Left
    lstODBCdbs.Width = frmODBC.ScaleWidth - (0.5 * cmdQuit.Width)
    lstODBCdbs.Height = LBHeight - (1.5 * lblDatabases.Height)

    lblDrivers.TOP = lblDatabases.TOP + LBHeight
    lblDrivers.Height = lblDatabases.Height
    lstODBCDrivers.TOP = lblDrivers.TOP + (1.25 * lblDrivers.Height)
    lstODBCDrivers.Left = cmdGetStatus.Left
    lstODBCDrivers.Width = frmODBC.ScaleWidth - (0.5 * cmdQuit.Width)
    lstODBCDrivers.Height = LBHeight - (1.5 * lblDrivers.Height)
End Sub